      subroutine parcelv_obj(ncells, ijkcell, nvtx, ijkvtx, nsp, iwid, jwid, &
         kwid, ijkctmp, itdim, iphead, iphd2, link, ico, massp, pxi, peta, pzta&
         , chip, wate, chi, mv) 
!-----------------------------------------------
!   M o d u l e s 
!-----------------------------------------------
      USE vast_kind_param, ONLY:  double 
      use modify_com_M 
 
!...Translated by Pacific-Sierra Research 77to90  4.3E  14:13:36   8/20/02  
!...Switches: -yf -x1             
      implicit none
!-----------------------------------------------
!   D u m m y   A r g u m e n t s
!-----------------------------------------------
      integer , intent(in) :: ncells 
      integer , intent(in) :: nvtx 
      integer , intent(in) :: nsp 
      integer  :: iwid 
      integer  :: jwid 
      integer  :: kwid 
      integer  :: itdim 
      integer , intent(in) :: ijkcell(*) 
      integer , intent(in) :: ijkvtx(*) 
      integer  :: ijkctmp(*) 
      integer  :: iphead(*) 
      integer , intent(inout) :: iphd2(*) 
      integer , intent(inout) :: link(0:*) 
      integer  :: ico(0:*) 
      real(double) , intent(in) :: massp(0:*) 
      real(double)  :: pxi(0:*) 
      real(double)  :: peta(0:*) 
      real(double)  :: pzta(0:*) 
      real(double) , intent(in) :: chip(0:*) 
      real(double)  :: wate(itdim,27) 
      real(double) , intent(inout) :: chi(*) 
      real(double) , intent(inout) :: mv(*) 
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
      integer , dimension(8) :: ijkvstep 
      integer :: l, n, newcell, ijk, newcell_nxt, is, np 
      real(double) :: nu 
      logical :: nomore 
!-----------------------------------------------
!
!
!
!
!
!      a routine to interpolate particle data to the vertices of grid
!
      call vtxindx (iwid, jwid, kwid, ijkvstep) 
!
!
!dir$ ivdep
      wate(ijkvtx(:nvtx),:8) = 0.0 
!
!
!dir$ ivdep
!
      iphd2(ijkcell(:ncells)) = 0 
      ijkctmp(:ncells) = ijkcell(:ncells) 
!
!
      newcell = ncells 
!
!     **************************************
!
!     set accumulators to zero
!
!     ********************************************
!
!dir$ ivdep
!
      mv(ijkvtx(:nvtx)) = 0.0 
      chi(ijkvtx(:nvtx)) = 0.0 
!
!
!
    1 continue 
      nomore = .TRUE. 
!
!
      newcell_nxt = 0 
      do n = 1, newcell 
         if (iphead(ijkctmp(n)) == 0) cycle  
         newcell_nxt = newcell_nxt + 1 
         ijkctmp(newcell_nxt) = ijkctmp(n) 
      end do 
!
      newcell = newcell_nxt 
!
      if (newcell /= 0) then 
         nomore = .FALSE. 
!
         call watev (newcell, ijkctmp, iphead, itdim, pxi, peta, pzta, wate) 
!
!dir$ ivdep
!
!
         do is = 1, nsp 
!
!
            do l = 1, 8 
!
!dir$ ivdep
!
               do n = 1, newcell 
!
                  ijk = ijkctmp(n) 
!
!     calculate the object mass at the vertices
!
                  mv(ijk+ijkvstep(l)) = mv(ijk+ijkvstep(l)) + massp(iphead(ijk)&
                     )*wate(ijk,l) 
!
                  chi(ijk+ijkvstep(l)) = chi(ijk+ijkvstep(l)) + chip(iphead(ijk&
                     ))*wate(ijk,l) 
!
               end do 
!
            end do 
!
         end do 
!
!
!     ************************************************
!
!
!
!
!
         do n = 1, newcell 
            ijk = ijkctmp(n) 
            np = iphead(ijk) 
            if (np <= 0) cycle  
            iphead(ijk) = link(np) 
            link(np) = iphd2(ijk) 
            iphd2(ijk) = np 
!
         end do 
      endif 
!
      if (.not.nomore) go to 1 
!
!dir$ ivdep
      do n = 1, ncells 
!
         ijk = ijkcell(n) 
!
         iphead(ijk) = iphd2(ijk) 
!
         iphd2(ijk) = 0 
!
      end do 
!
      return  
      end subroutine parcelv_obj 
